home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus Special 16 / AMIGAplus Sonderheft 16 (1998)(ICP)(DE)[!].iso / pd / anwendungen / amicad / arexx_english / testnets.amicad < prev    next >
Text File  |  1998-08-09  |  7KB  |  287 lines
  1. /* $VER: TestNets 1.00e (© R.Florac, 9 août 1998) */
  2.  
  3. options results
  4.  
  5. signal on error
  6. signal on syntax
  7.  
  8. c=1
  9. 'SAVEALL(-1):UNMARK(-1):OBJECTS(-1)'; objets=result
  10. 'DEF UNMARKCOMP(O)=IF(GETREF(O),UNMARK(GETREF(O)),0):IF(GETVAL(O),UNMARK(GETVAL(O)),0):UNMARK(O)'
  11.  
  12. modifs=0; eliminations=0; errrefs=0; errvals=0; errconx=0; doublets=0
  13. c="Check sheet"||'0a'x||"1- Check references "||'0a'x||"2- Check values"||'0a'x||"3- Check connexions"||'0a'x||"4- Check nets"||'0a'x||"5- Check superpositions"||'0a'x
  14. c=c||"6- Chain all"||'0a'x||"7- Abort"
  15. 'SELECT("'c'")'
  16. c=result
  17. select
  18.     when c=1 then call test_refs
  19.     when c=2 then call test_valeurs
  20.     when c=3 then call test_connexions
  21.     when c=4 then call test_liaisons
  22.     when c=5 then call test_doublets
  23.     when c=6 then do
  24.     call test_doublets
  25.     call test_refs
  26.     call test_valeurs
  27.     call test_connexions
  28.     call test_liaisons
  29.     end
  30.     otherwise exit
  31. end
  32. call afficher_erreurs
  33. exit
  34.  
  35. test_refs:
  36.     'LOCK(-1):TITLE("Checking references...")'
  37.     do i=1 to objets
  38.     'TYPE(O='i')'
  39.     if result=1 then do
  40.         'PARTNAME(O)'
  41.         if result~="POWER SUPPLY" & result ~="GROUND" then do
  42.         'GETREF(O)'
  43.         if result=0 then do
  44.             'MARK(O):REQUEST("Warning: object 'i'"+CHR(10)+"("+PARTNAME(O)+")"+CHR(10)+"located in "+STR(COL(O))+" "+STR(LINE(O))+CHR(10)+"have no reference"+CHR(10)+"Do you want to continue?")'
  45.             if result<1 then do
  46.             'UNLOCK(-1)'
  47.             return
  48.             end
  49.             'UNMARKCOMP(O)'
  50.             errrefs=errrefs+1
  51.         end
  52.         end
  53.     end
  54.     end
  55.     'UNLOCK(-1)'
  56. return
  57.  
  58. test_valeurs:
  59.     'LOCK(-1):TITLE("Checking values..."):UNMARK(-1)'
  60.     do i=1 to objets
  61.     'TYPE(O='i')'
  62.     if result=1 then do
  63.         'PARTNAME(O)'
  64.         if result~="POWER SUPPLY" & result ~="GROUND" then do
  65.         'GETVAL(O)'
  66.         if result=0 then do
  67.             'MARK(O):REQUEST("Warning: object 'i'"+CHR(10)+"("+PARTNAME(O)+")"+CHR(10)+"located in "+STR(COL(O))+" "+STR(LINE(O))+CHR(10)+"have no value"+CHR(10)+"Do you want to continue?")'
  68.             if result<1 then do
  69.             'UNLOCK(-1)'
  70.             return
  71.             end
  72.             'UNMARKCOMP(O)'
  73.             errvals=errvals+1
  74.         end
  75.         end
  76.     end
  77.     end
  78.     'UNLOCK(-1)'
  79. return
  80.  
  81. test_doublets:
  82.     'LOCK(-1):TITLE("Checking superpositions..."):UNMARK(-1)'
  83.     i=1
  84.     do while i>0
  85.     'O=FINDOBJ('i',1,-1,-1)'; i=result
  86.     if i>0 then do
  87.         'N=FINDOBJ('i+1',1,COL(O),LINE(O))'; j=result
  88.         if j>0 then do
  89.         'IF(PARTNAME(O)==PARTNAME(N),IF(GETREF(N),DELETE(GETREF(N)),0):IF(GETVAL(N),DELETE(GETVAL(N)),0):DELETE(N):MARK(O),0):OBJECTS(-1)'; objets=result
  90.         doublets=doublets+1
  91.         end
  92.         if i>=objets-1 then i=0
  93.         else i=i+1
  94.     end
  95.     end
  96.     i=1
  97.     do while i>0
  98.     'O=FINDOBJ('i',1,-1,-1)'; i=result
  99.     if i>0 then do
  100.         'GETREF(O)'; r=result
  101.         if r>0 then do
  102.         'D=FINDREF('i+1',READTEXT(GETREF(O)))'; d=result
  103.         if d>0 then do
  104.             'MARK(O,D):MESSAGE("Warning: reference"+CHR(10)+READTEXT(GETREF(O))+CHR(10)+"is used twice!")'
  105.         end
  106.         end
  107.         if i>=objets-1 then i=0
  108.         else i=i+1
  109.     end
  110.     end
  111.     'UNLOCK(-1)'
  112. return
  113.  
  114. test_connexions:
  115.     'LOCK(-1):TITLE("Checking junctions to components..."):UNMARK(-1)'
  116.     i=1
  117.     do while i>0
  118.     'O=FINDOBJ('i',1,-1,-1)'; i=result
  119.     if i>0 then do
  120.         'PARTNAME(O)'
  121.         'DEVPINS(O)'; j=result
  122.         do k=1 to j
  123.         if connexion_broche(i,k)=0 then do
  124.             'MARK(O):REQUEST("Warning object 'i'"+CHR(10)+"("+PARTNAME(O)+")"+CHR(10)+"located in "+STR(COL(O))+" "+STR(LINE(O))+CHR(10)+"have his pin "+STR(IF(PINNUM(O,'k'),PINNUM(O,'k'),'k'))+" not connected"+CHR(10)+"Do you want to continue?")'
  125.             if result<1 then do
  126.             'UNLOCK(-1)'
  127.             return
  128.             end
  129.             'UNMARKCOMP(O)'
  130.             errconx=errconx+1
  131.         end
  132.         end
  133.         if i=objets then leave
  134.         i=i+1
  135.     end
  136.     end
  137.     'UNLOCK(-1)'
  138. return
  139.  
  140. test_liaisons:
  141.     'LOCK(-1):TITLE("Looking for unused lines...")'
  142.     i=1
  143.     do while i>0
  144.     'O=FINDOBJ('i',2,-1,-1)'; i=result
  145.     if i>0 then do
  146.         'IF((COL(O)==ENDCOL(O))&(LINE(O)==ENDLINE(O)),DELETE(O),0)'
  147.         if result>0 then do
  148.         objets=result
  149.         eliminations=eliminations+1
  150.         end
  151.         else if i<objets then do
  152.         'IF(COL(O)==ENDCOL(O),1,IF(LINE(O)==ENDLINE(O),2,0))'
  153.         if result=1 then do
  154.             l=i+1
  155.             do while l>0
  156.             'L=FINDOBJ('l',2,COL(O),-1)'; l=result
  157.             if l>0 then do
  158.                 'IF(COL(L)==ENDCOL(L),COORDS(O)+","+COORDS(L),"")'
  159.                 if result~="" then do
  160.                 parse var result x0','y0','x1','y1','x2','y2','x3','y3
  161.                 y4=min(y0,y1)
  162.                 y5=max(y0,y1)
  163.                 y6=min(y2,y3)
  164.                 y7=max(y2,y3)
  165.                 if y4<y7 & y5>y6 then call modifier_lignes(x0,min(y4,y6),x0,max(y5,y7))
  166.                 else if y4=y7 then do
  167.                     'FINDOBJ(1,7,'x0','y4')'
  168.                     if result=0 then call modifier_lignes(x0,y6,x0,y5)
  169.                 end
  170.                 else if y5=y6 then do
  171.                     'FINDOBJ(1,7,'x0','y5')'
  172.                     if result=0 then call modifier_lignes(x0,y4,x0,y7)
  173.                 end
  174.                 end
  175.             end
  176.             if l>0 then do
  177.                 if l>=objets then l=0
  178.                 else l=l+1
  179.             end
  180.             end
  181.         end
  182.         else if result=2 then do
  183.             l=i+1
  184.             do while l>0
  185.             'L=FINDOBJ('l',2,-1,LINE(O))'; l=result
  186.             if l>0 then do
  187.                 'IF(LINE(L)==ENDLINE(L),COORDS(O)+","+COORDS(L),"")'
  188.                 if result~="" then do
  189.                 parse var result x0','y0','x1','y1','x2','y2','x3','y3
  190.                 x4=min(x0,x1)
  191.                 x5=max(x0,x1)
  192.                 x6=min(x2,x3)
  193.                 x7=max(x2,x3)
  194.                 if x4<x7 & x5>x6 then call modifier_lignes(min(x4,x6),y0,max(x5,x7),y0)
  195.                 else if x4=x7 then do
  196.                     'FINDOBJ(1,7,'x4','y0')'
  197.                     if result=0 then call modifier_lignes(x6,y0,x5,y0)
  198.                 end
  199.                 else if x5=x6 then do
  200.                     'FINDOBJ(1,7,'x5','y0')'
  201.                     if result=0 then call modifier_lignes(x4,y0,x7,y0)
  202.                 end
  203.                 end
  204.             end
  205.             if l>0 then do
  206.                 if l>=objets then l=0
  207.                 else l=l+1
  208.             end
  209.             end
  210.         end
  211.         end
  212.         if i>=objets-1 then i=0
  213.         else i=i+1
  214.     end
  215.     else leave
  216.     end
  217.     'UNLOCK(-1)'
  218. return
  219.  
  220. afficher_erreurs:
  221.     if eliminations=0 & modifs=0 & errrefs=0 & errvals=0 & errconx=0 & doublets=0 then 'MESSAGE("Checking ended"+CHR(10)+"No error found")'
  222.     else do
  223.     t=""
  224.     if eliminations>0 then t=eliminations||" unused lines deleted"
  225.     if modifs>0 then do
  226.         if t~="" then t=t||'0a'x||modifs||" modified lines"
  227.         else t=modifs||" modified lines"
  228.     end
  229.     if errrefs>0 then do
  230.         if t~="" then t=t||'0a'x||errrefs||" missing references"
  231.         else t=errrefs||" missing references"
  232.     end
  233.     if errvals>0 then do
  234.         if t~="" then t=t||'0a'x||errvals||" missing values"
  235.         else t=errvals||" missing values"
  236.     end
  237.     if errconx>0 then do
  238.         if t~="" then t=t||'0a'x||errconx||" missing connexions"
  239.         else t=errconx||" missing connexions"
  240.     end
  241.     if doublets>0 then do
  242.         if t~="" then t=t||'0a'x||doublets||" deleted objects"
  243.         else t=doublets||" deleted objects"
  244.     end
  245.     'MESSAGE("'t'")'
  246.     end
  247.     return
  248.  
  249. modifier_lignes:
  250.     parse arg xd,yd,xf,yf
  251.     'DRAWMODE(1):DELETE(L):DELETE(O):MARK(DRAW('xd','yd','xf','yf'))'
  252.     objets=objets-1
  253.     i=0; l=0
  254.     modifs=modifs+1
  255.     return
  256.  
  257. connexion_broche: procedure
  258.     parse arg objet,broche
  259.     'PINCOL(O='objet',B='broche')'; xj=result
  260.     'PINLINE(O,B)'; yj=result
  261.     'FINDOBJ(1,2,'xj','yj')'; xl=result
  262.     if xl>0 then return xl
  263.     'FINDLINE(1,'xj','yj')'; xl=result
  264.     if xl<=0 then return 0
  265.     'FINDOBJ(1,7,'xj','yj')'
  266.     if result>0 then return xl
  267.     return 0
  268.  
  269. min: procedure
  270.     parse arg v1,v2
  271.     if v1<v2 then return v1
  272.     return v2
  273.  
  274. max: procedure
  275.     parse arg v1,v2
  276.     if v1>v2 then return v1
  277.     return v2
  278.  
  279. syntax:
  280. erreur=RC
  281. 'MESSAGE("Script TestNets.AmiCAD"+CHR(10)+"Syntax error"+CHR(10)+"in line 'SIGL'"+CHR(10)+"'errortext(erreur)'")'
  282. exit
  283.  
  284. error:
  285. 'MESSAGE("Script TestNets.AmiCAD"+CHR(10)+"Error in line 'SIGL'")'
  286. exit
  287.